Results plots
Raw outcomes
Assets
Mean asset outcomes by arm and period.
Click here to see the code to produce plots.
#### Run ComputeNetAssetsANCOVA.R first to produce
#### various "Figure" data. This is ran in
#### ### Descriptive statistics as a knitr child file.
#### source(paste0(pathprogram, "ComputeNetAssetsANCOVA.R"))
NeA1R <- readRDS(paste0(pathsaveHere,
"NetAssetsANCOVATrimmed.rds"))
cpn <- NeA1R[(CompleteAssetPanel) & tee == 1,
.(Arm, hhid, tee,
CP=CompleteAssetPanel, NLHAssetAmount,
PAssetAmount, NumCows)]
#### comple asset panel sample is only 220 HHs
#### and only 35 HHs for traditional
lvoD <- readRDS(paste0(pathsaveHere,
"NumCowsFigure.rds"))
nAD <- readRDS(paste0(pathsaveHere,
"AllNetAssetsFigureMeanData.rds"))
cpn <- readRDS(paste0(pathsaveHere,
"CPNetAssetsFigureMeanData.rds"))
conD <- readRDS(paste0(pathsaveHere,
"ConsumptionFigure.rds"))
labDHH <- readRDS(paste0(pathsaveHere,
"HHLabourIncomeFigure.rds"))
labDpc <- readRDS(paste0(pathsaveHere,
"pcHHLabourIncomeFigure.rds"))
schD <- readRDS(paste0(pathsaveHere,
"SchoolingFigure.rds"))
schD[, file := Schooling]
#### break down various asset measures in nAD
nAD[grepl("cow", Arm), Arm := "cattle"]
armsC <- c("traditional", "large", "large grace", "cattle")
nAD[, Arm := factor(Arm, levels = armsC)]
na <- nAD[, .(Arm, tee, NetValue..mean, NetValue..upper,
NetValue..lower, NetValue..N)]
pal <- nAD[, .(Arm, tee, ProdValue..mean, ProdValue..upper,
ProdValue..lower, ProdValue..N)]
pa <- nAD[, .(Arm, tee, PAssetAmount..mean,
PAssetAmount..upper, PAssetAmount..lower, PAssetAmount..N)]
cpn <- cpn[, .(Arm, tee, NetValue..mean, NetValue..upper,
NetValue..lower, NetValue..N)]
setnames(na, grepout("Ne", colnames(na)),
c("mean", "upper", "lower", "N"))
setnames(pal, colnames(na))
setnames(pa, colnames(na))
setnames(cpn, colnames(na))
figD <- rbindlist(list(
cbind(file = "NumCows", lvoD),
cbind(file = "PAssetAmount", pa),
cbind(file = "ProdValue", pal),
cbind(file = "NetAssets", na),
cbind(file = "CPNetAssets", cpn),
cbind(file = "Consumption", conD),
cbind(file = "HHLabourIncomes", labDHH),
cbind(file = "pcHHLabourIncomes", labDpc),
schD[, .(file, Arm, sex, tee, lower, mean, upper, N)]
), use.names = T, fill = T)
figD[, file := factor(file, levels = c(
"NumCows", "PAssetAmount", "ProdValue",
"NetAssets", "CPNetAssets",
"Consumption", "HHLabourIncomes", "pcHHLabourIncomes",
"primary0512", "junior1315", "high1618"))]
figD[, file := factor(file, labels = c(
"NumCows", "PAssetAmount", "ProdValue",
"NetAssets", "CPNetAssets",
"Consumption", "HHIncomes", "pcIncomes",
"Sch0512", "Sch1315", "Sch1618"))]
figD[is.na(sex), sex := "NA"]
figD[, sex := factor(sex, labels = c("M", "F", "NA"))]
figD[, Sex := factor(sex, labels =
c("Male", "Female", "Per household"))]
figD[grepl("tra", Arm), Arm := "Traditional"]
figD[grepl("ge$", Arm), Arm := "Large"]
figD[grepl("ce$", Arm), Arm := "LargeGrace"]
figD[grepl("^ca", Arm), Arm := "Cattle"]
figD[, Arm := factor(Arm, levels = c(Arms[-4], "Cattle"))]
saveRDS(figD, paste0(pathsaveHere, "figD.rds"))
Consumption and labour incomes
Mean consumption and income outcomes by arm and period.
Click here to see the code to produce plot.
Saving and repayment
Click here to see the code of cumulative repayment plots.
library(ggplot2)
ga <- arA[!is.na(Date) & !is.na(DisDate1) & grepl("Yes", creditstatus),
.(Arm, hhid, povertystatus, MonthsElapsed,
DebtOutstanding, CumLoanAmount, value.repay, value.NetSaving,
CumPlannedInstallment, CumRepaidRate, CumEffectiveRepaidRate)]
ga <- arA[!is.na(Date) & !is.na(DisDate1) & grepl("Yes", creditstatus),
.(Arm, hhid, povertystatus, MonthsElapsed,
value.NetSaving, CumRepaid)]
ga1 <- ga[, !grepl("Ne", colnames(ga)), with = F]
ga1[, variable := "cumulative repayment"]
ga2 <- ga[, !grepl("Rep", colnames(ga)), with = F]
ga2[, variable := "weekly net saving"]
setnames(ga1, grepout("Re", colnames(ga1)), "amount")
setnames(ga2, grepout("Ne", colnames(ga2)), "amount")
ga <- rbindlist(list(ga1, ga2))
ga[, Arm := factor(Arm, labels = c(Arms[-4], "Cattle"))]
ga[, variable := factor(variable)]
ColourForPoints <- c("darkblue", "darkred")
g1 <- ggplot(ga[grepl("rep", variable), ],
aes(x = MonthsElapsed, y = amount,
colour = povertystatus, group = povertystatus)) +
geom_point(aes(fill = povertystatus), size = .01,
position = position_dodge(width = .5), #colour = "transparent",
alpha = .6) +
geom_smooth(span = .5, size = .75,
aes(colour = povertystatus, group = povertystatus)) +
scale_colour_manual(values = ColourForPoints) +
scale_fill_manual(values = c("blue", "red")) +
theme(
legend.position="none",
plot.margin = margin(t = 0, b = 0, l = 0, r = 0, "cm"),
axis.text = element_text(size = 7),
axis.title = element_text(size = 7),
strip.text.x = element_text(color = "blue", size = 6,
margin = margin(0, .5, 0, .5, "cm")),
strip.text.y = element_text(color = "blue", size = 6,
margin = margin(.5, 0, .5, 0, "cm"))
) +
scale_y_continuous(limits = c(0, 20000)) +
scale_x_continuous(limits = c(0, 48), breaks = seq(0, 48, 12))+
xlab("Months since 1st loan disbursement") +
ylab("Amount (BDT)") +
facet_grid(variable ~ Arm)
g2 <- ggplot(ga[grepl("sav", variable), ],
aes(x = MonthsElapsed, y = amount,
colour = povertystatus, group = povertystatus)) +
geom_point(aes(fill = povertystatus), size = .01,
position = position_dodge(width = .5), #colour = "transparent",
alpha = .6) +
geom_smooth(span = .5, size = .75,
aes(colour = povertystatus, group = povertystatus)) +
scale_colour_manual(values = ColourForPoints) +
scale_fill_manual(values = c("blue", "red")) +
theme(
legend.position="bottom",
legend.text = element_text(size = 7),
legend.title = element_text(size = 9),
legend.key = element_rect(fill = "white"),
legend.key.size = unit(.25, "cm"),
axis.text = element_text(size = 7),
axis.title = element_text(size = 7),
strip.text.x = element_text(color = "blue", size = 6,
margin = margin(0, .5, 0, .5, "cm")),
strip.text.y = element_text(color = "blue", size = 6,
margin = margin(.5, 0, .5, 0, "cm"))
) +
scale_y_continuous(limits = c(0, 800)) +
scale_x_continuous(limits = c(0, 48), breaks = seq(0, 48, 12))+
xlab("Months since 1st loan disbursement") +
ylab("Amount (BDT)") +
facet_grid(variable ~ Arm)
library(gridExtra)
g <- grid.arrange(g1, g2, heights = c(2, 2.5), ncol=1)Weekly net saving and cumulative repayment by poverty status
ggsave(
paste0(pathprogram,
"figure/ImpactEstimationOriginal1600Memo2/",
"CumulativeWeeklyNetSavingAndRepayment.png"),
g,
width = 14, height = 10, units = "cm",
dpi = 400
)
library(grid)
cairo_pdf(
paste0(pathprogram,
"figure/ImpactEstimationOriginal1600Memo2/",
"CumulativeWeeklyNetSavingAndRepayment.pdf"),
, width = 13/2.54, height = 10/2.54, pointsize = 10) # native unit: inch
grid.draw(g)
whatever <- dev.off()ggplot2::geom_smooth function, originally from
mgcv::gam with bs=cs’`.
Weekly net saving and cumulative repayment by poverty status
Note: Each dot represents weekly observations. Only members who
received loans are shown. Each panel shows ratios of cumulative
repayment against cumulative due amount, sum of cumulative repayment and
cumulative net saving (saving - withdrawal) against cumulative due
amount, against weeks after first disbursement. Lines are smoothed lines
with a penalized cubic regression spline in
ggplot2::geom_smooth function, originally from
mgcv::gam with bs=cs’`.
Click here to see the code of cumulative repaid rate plots.
library(ggplot2)
ga <- arA[!is.na(Date) & !is.na(DisDate1) & grepl("Yes", creditstatus) &
grepl("bo", BStatus) & o800 == 1L,
.(Arm, hhid, povertystatus, MonthsElapsed,
CumNetSaving, CumRepaid, CumRepaidRate, CumEffectiveRepaidRate)]
#### ga1: amount
ga1 <- ga[, !grepl("Ne|Rate", colnames(ga)), with = F]
ga1[, variable := "repayment"]
#### ga2: rate
ga20 = copy(ga)
ga20 <- ga20[, grepout("Ne|Repaid$|variab", colnames(ga20)) := NULL]
ga20 <- ga20[!is.na(CumEffectiveRepaidRate) &
!is.na(CumEffectiveRepaidRate), ]
ga21 <- ga20[, .(Arm, hhid, povertystatus, MonthsElapsed, CumEffectiveRepaidRate)]
ga22 <- ga20[, .(Arm, hhid, povertystatus, MonthsElapsed, CumRepaidRate)]
setnames(ga21, "CumEffectiveRepaidRate", "value")
setnames(ga22, "CumRepaidRate", "value")
ga21[, variable := "Repay+net saving"]
ga22[, variable := "Repayment"]
ga2 <- rbindlist(list(ga21, ga22))
ga2[, variable := factor(variable,
levels = c("Repayment", "Repay+net saving"))]
setnames(ga1, grepout("Re", colnames(ga1)), "amount")
#setnames(ga2, grepout("Re", colnames(ga2)), "amount")
#ga <- rbindlist(list(ga1, ga2))
ColourForPoints <- c("darkblue", "darkred")
g <- ggplot(ga2,
aes(x = MonthsElapsed, y = value,
colour = povertystatus, group = povertystatus)) +
geom_point(aes(fill = povertystatus), size = .01,
position = position_dodge(width = .5), #colour = "transparent",
alpha = .6) +
geom_smooth(span = .5, size = .5, #colour = "blue",
aes(colour = povertystatus, group = povertystatus)) +
scale_colour_manual(values = ColourForPoints) +
scale_fill_manual(values = c("blue", "red")) +
#### scale_shape_manual(values=c(21, 25)) +
theme(
legend.position="bottom",
legend.text = element_text(size = 7),
legend.title = element_text(size = 9),
legend.key = element_rect(fill = "white"),
legend.key.size = unit(.5, "cm"),
axis.text = element_text(size = 7),
axis.title = element_text(size = 7),
strip.text.x = element_text(color = "blue", size = 6,
margin = margin(0, .5, 0, .5, "cm")),
strip.text.y = element_text(color = "blue", size = 6,
margin = margin(.5, 0, .5, 0, "cm"))
) +
scale_y_continuous(limits = c(0, 2)) +
scale_x_continuous(limits = c(0, 48), breaks = seq(0, 48, 12)) +
xlab("Months since 1st loan disbursement") +
ylab("Cumulative repayment rates") +
facet_grid(variable ~ Arm, scales = "free_y") +
geom_hline(aes(yintercept = 1), colour = "lightgreen", data = ga2)
ggsave(
paste0(pathprogram,
"figure/ImpactEstimationOriginal1600Memo2/",
"CumulativeWeeklyRepaymentRateByPovertystatus.png"),
g,
width = 12, height = 6, units = "cm",
dpi = 300
)Cumulative weekly net repayment rates by poverty status
The study followed the stepped wedge design within each group due to administrative and budgetary constraints. Our initial identification strategy was comaprison between arms and did not use the stepped wedge design to estimate impacts because of possible spillovers within a group and a relatively short period for outcomes to change before the control gets treated [We can estimate within-group, we may just have underestimated impacts]. A half of members in a group, approximately 800 in total, are assigned initially as the treated and then the rest was treated in the following months. So the number of the treated increased as time passes.
We restrict ourselves to this initial 800 members in estimating the impacts. We do so because of possible spill overs within groups. We compare between arms, not individuals in a group. One can see how impacts may differ if we compare between-group and within-group estimates. Such comparison is left as future exercises.
We will add a binary indicator function o800 to indicate the initial sample. In below, we first use the roster-administrative data to choose the households of o800, because it has the most complete record. Then, I look for these households in other files and create o800 variable in them.
Impact estimates
Assets
Click here to see the code.
library(ggplot2)
confi <- qread(paste0(pathsaveHere, "EstimatesCI.qs"))
confi1 <- confi[
grepl("^NetAssets$", FileName) &
!grepl("None|Adi|Own", FileName) &
!grepl("Tr|Up", attributes) &
grepl("^periN", hv) &
grepl("Ta?$", regtype), ]
confi1[grepl("^Large$", attributes), attributes := "Large/Upfront"]
cols <- c("FileName", "regressand", "attributes", "regtype")
confi1[, (cols) := droplevels(.SD), .SDcols = cols]
confi1[, attributes := factor(attributes, levels =
c("Large/Upfront", "LargeGrace", "Cattle", "WithGrace", "InKind"))]
confi1[, num := factor(num-1)]
p <- ggplot(data = confi1
, aes(x = factor(period), y = estimate,
colour = num, shape = num, group = num)) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .5))
p <- p + facet_grid( ~ attributes, scales = "free_y") +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 5, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 6),
axis.title = element_text(size = 6),
strip.text.x = element_text(color = "blue", size = 9,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
panel.spacing.x = unit(c(.1, .1, .3, .1), units = "cm"),
panel.spacing.y = unit(.1, units = "cm"),
legend.position="bottom") +
xlab("periods") +
labs(color = "regression specifications", shape = "regression specifications") +
guides(colour = guide_legend(title = "regression specifications", nrow = 1)) +
geom_hline(aes(yintercept = 0), data = confi1, colour = "lightgreen")
p <- p + ggh4x::facet_nested( ~ AtType+attributes, scales = "free_y")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/NetAssetsEffects.jpg"),
p,
width = 13*2, height = 6*2, units = "cm",
dpi = 600
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/NetAssetsEffects.pdf")
, width = 2*12/2.54, height = 2*5/2.54)
print(p)
whatever <- dev.off()library(ggplot2)
confi <- qread(paste0(pathsaveHere, "EstimatesCI.qs"))
confi1 <- confi[
grepl("Annual|^NetB|NetNL|ws$", FileName) &
!grepl("None|Adi|Own", FileName) &
!grepl("Tr|Up", attributes) &
grepl("^periN", hv) &
grepl("T$", regtype) & num > 1, ]
confi1[grepl("^Large$", attributes), attributes := "Large"]
cols <- c("FileName", "regressand", "attributes", "regtype")
confi1[, (cols) := droplevels(.SD), .SDcols = cols]
confi1[, regressand := factor(regressand, levels =
c("net assets, AP", "net non-livestock assets", "net broad assets", "cattle"))]
confi1[, regressand := factor(regressand, labels =
c("Net assets,\nannual price (BDT)", "Net non-livestock\n assets (BDT)",
"Net broad assets\n (BDT)", "Cattle (counts)"))]
table(confi1[,.(attributes, regressand)]) regressand
attributes Net assets,\nannual price (BDT) Net non-livestock\n assets (BDT)
Large 15 15
LargeGrace 15 15
Cattle 15 15
regressand
attributes Net broad assets\n (BDT) Cattle (counts)
Large 15 9
LargeGrace 15 9
Cattle 15 9confi1[, num := factor(num-1)]
p <- ggplot(data = confi1
, aes(x = factor(period), y = estimate,
colour = num, shape = num, group = num)) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .5))
p <- p + facet_grid(regressand ~ attributes, scales = "free_y") +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 7, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 8),
axis.title = element_text(size = 8),
strip.text.x = element_text(color = "blue", size = 9,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
#panel.spacing.x = unit(c(.1, .1, .3, .1), units = "cm"),
#panel.spacing.y = unit(.1, units = "cm"),
legend.position="bottom") +
xlab("periods") +
labs(color = "regression specifications", shape = "regression specifications") +
guides(colour = guide_legend(title = "regression specifications", nrow = 1)) +
geom_hline(aes(yintercept = 0), data = confi1, colour = "lightgreen")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/NetAssetsNetBroadAssetsNLAssetsCattleEffects.jpg"),
p,
width = 13*1.5, height = 12*1.5, units = "cm",
dpi = 300
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/NetAssetsNetBroadAssetsNLAssetsCattleEffects.pdf")
, width = 2*12/2.54, height = 2*8/2.54)
print(p)
whatever <- dev.off()Net asset impacts are estimated with ANCOVA.
Large/Upfront , LargeGrace, and
Cattle give impacts relative to Traditional
arm. `WithGrace gives the grace period impacts relative to
Upfront. InKind gives the impacts of
managerial supports relative to the combination of Upfront
and WithGrace. s```
Robustness checks: Impacts on various asset measures. Time-varying
impacts on net assets evaluated with annualised price, net broad assets,
non-livestock assets (BDT), and cattle holding (counts). Net asset value
= livestock asset value + non-livestock asset value - debt.
Net broad assets use all asset items, net assets in our
main results only use asset items appearing in all rounds.
Net assets, annual price uses annual median price for
livestock evaluation while Net assets uses median price of
all rounds. Columns of Large, Large grace, and
Cattle show impacts relative to the
Traditional arm. 4th and 5th regression specifications use
baseline cattle count and baseline cattle ownership dummy variable as
covariates, hence they are omitted from impacts on Cattle (counts).
s```
Robust to:
- Choice of asset definition (net broad assets vs. net assets).
- Choice of price index (overall median vs. annual median).
- Choice of asset type (total vs. non-livestock vs. cattle).
Schooling
Click here to see the code.
library(ggplot2)
confis <- qread(paste0(pathsaveHere, "EstimatesCISchooling.qs"))
confi2 <- unique(confis)
confi2 <- confi2[!grepl("^Up", attributes), ]
confi2 <- confi2[grepl("^Large$", attributes), attributes := "Large/Upfront"]
confi2 <- confi2[grepl("T$", regtype), ]
cols <- c("FileName", "school", "attributes")
confi2[, (cols) := droplevels(.SD), .SDcols = cols]
confi2[, attributes := factor(attributes, levels =
c("Traditional", "Large/Upfront", "LargeGrace", "Cattle"))]
confi2[, attributes := factor(attributes, labels =
c("Traditional", "Large", "LargeGrace", "Cattle"))]
#### Trad: Level in each period at school i
confi2t <- confi2[(grepl("^Tra", attributes) & grepl("lev.* trad.*ea", ImpactType)) & num >= 5, ]
#### Nontrad: nontrad - trad, in each period, at school i
confi2n <- confi2[grepl("change", ImpactType) & num >= 5, ][order(gender, period), ]
confi3 <- rbind(confi2t, confi2n)
confi3[, num := factor(num-4)]
faccol <- c("attributes", "gender", "ImpactType", "hv", "regtype", "num")
confi3[, (faccol) := lapply(.SD, droplevels), .SDcol = faccol]
table(confi3[,.(ImpactType, attributes)]) attributes
ImpactType Traditional Large
level of trad in each period at school 18 0
level of female trad in each period at school 18 0
nontrad change - trad change, in each period, at school 0 18
female nontrad change - female trad change, in each period, at school 0 18
attributes
ImpactType LargeGrace Cattle
level of trad in each period at school 0 0
level of female trad in each period at school 0 0
nontrad change - trad change, in each period, at school 18 18
female nontrad change - female trad change, in each period, at school 18 18confi3[, numgen := paste0(gender, ", spec", num)]
confi3[, effects := "Level estimates"]
confi3[!grepl("Trad", attributes), effects := "Marginal impacts relative to Traditional"]
confi3[, numgen := paste0(gender, ", spec", num)]
confi3[, effects := "Level estimates"]
confi3[!grepl("Trad", attributes), effects := "Marginal impacts relative to Traditional"]
p <- ggplot(data = confi3
, aes(x = factor(period), y = estimate,
colour = numgen, shape = numgen, group = numgen)) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .25))
p <- p + facet_grid(school ~ attributes, scales = "free_y") +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 7, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 7),
axis.title = element_text(size = 7),
strip.text.x = element_text(color = "blue", size = 9,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
panel.spacing.x = unit(c(.3, .1, .1), units = "cm"),
panel.spacing.y = unit(.1, units = "cm"),
legend.position="bottom",
legend.key.size = unit(0.1, "cm"),
legend.text = element_text(size = 7)) +
xlab("periods") +
labs(color = "gender, regression specifications", shape = "gender, regression specifications") +
guides(colour = guide_legend(title = "gender, regression specifications", nrow = 1)) +
geom_hline(aes(yintercept = 0), data = confi3, colour = "lightgreen")
p <- p + ggh4x::facet_nested(school ~ effects + attributes, scales = "free_y")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/SchoolingEffectsConcurrentWithTradByArm.jpg"),
p,
width = 14*2, height = 12*2, units = "cm",
dpi = 450
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/SchoolingEffectsConcurrentWithTradByArm.pdf"),
, width = 12*2/2.54, height = 12*2/2.54)
print(p)
whatever <- dev.off()library(ggplot2)
confis <- qread(paste0(pathsaveHere, "EstimatesCISchooling.qs"))
confi2 <- unique(confis)
confi2 <- confi2[grepl("^Large$", attributes), attributes := "Large/Upfront"]
confi2 <- confi2[grepl("Ta$", regtype), ]
cols <- c("FileName", "school", "attributes")
confi2[, (cols) := droplevels(.SD), .SDcols = cols]
confi2[, attributes := factor(attributes, levels =
c("Traditional", "Upfront", "WithGrace", "InKind"))]
#### Trad: Level in each period at school i
confi2t <- confi2[(grepl("^Tra", attributes) & grepl("lev.* trad.*ea", ImpactType)) & num >= 5, ]
#### Nontrad: nontrad - trad, in each period, at school i
confi2n <- confi2[grepl("change", ImpactType) & num >= 5, ][order(gender, period), ]
confi3 <- rbind(confi2t, confi2n)
confi3[, num := factor(num-4)]
faccol <- c("attributes", "gender", "ImpactType", "hv", "regtype", "num")
confi3[, (faccol) := lapply(.SD, droplevels), .SDcol = faccol]
table(confi3[,.(ImpactType, attributes)]) attributes
ImpactType Traditional Upfront
level of trad in each period at school 18 0
level of female trad in each period at school 18 0
nontrad change - trad change, in each period, at school 0 18
female nontrad change - female trad change, in each period, at school 0 18
attributes
ImpactType WithGrace InKind
level of trad in each period at school 0 0
level of female trad in each period at school 0 0
nontrad change - trad change, in each period, at school 18 18
female nontrad change - female trad change, in each period, at school 18 18confi3[, numgen := paste0(gender, ", spec", num)]
confi3[, effects := "Level estimates"]
confi3[!grepl("Trad", attributes), effects := "Marginal impacts relative to \nTraditional, Upfront, Upfront+WithGrace"]
confi3[, attributes := factor(attributes, label = c("Traditional",
"Upfront\nrelative to Traditional", "WithGrace\nrelative to Upfront",
"InKind\nrelative to Upfront+WithGrace"))]
p <- ggplot(data = confi3
, aes(x = factor(period), y = estimate,
colour = numgen, shape = numgen, group = numgen)) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .25))
p <- p + facet_grid(school * gender ~ attributes, scales = "free_y") +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 7, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 7),
axis.title = element_text(size = 7),
strip.text.x = element_text(color = "blue", size = 8,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
panel.spacing.x = unit(c(.3, .1, .1), units = "cm"),
panel.spacing.y = unit(.1, units = "cm"),
legend.position="bottom",
legend.key.size = unit(0.1, "cm"),
legend.text = element_text(size = 7)) +
xlab("periods") +
labs(color = "regression specifications", shape = "regression specifications") +
guides(colour = guide_legend(title = "regression specifications", nrow = 1)) +
geom_hline(aes(yintercept = 0), data = confi3, colour = "lightgreen")
p <- p + ggh4x::facet_nested(school ~ effects + attributes, scales = "free_y")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/SchoolingEffectsConcurrentWithTradByFunAttribute.jpg"),
p,
width = 14*2, height = 12*2, units = "cm",
dpi = 450
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/SchoolingEffectsConcurrentWithTradByFunAttribute.pdf"),
, width = 12*2/2.54, height = 10*2/2.54)
print(p)
whatever <- dev.off()Schooling impacts by arm and by period. Impacts are relative to
concurrent Traditional arm. Traditional shows
raw enrollment rates of Traditional arm. Large
, LargeGrace, and Cattle give impacts relative
to concurrent Traditional arm.
Schooling impacts by functional attribute and by period. Impacts are
relative to respective concurrent functional attrnibutes.
Traditional shows raw enrollment rates of
Traditional arm. Upfront gives concurrent
upfront liquidity impacts relative to Traditional.
WithGrace gives concurrent grace period impacts relative to
Upfront. InKind gives concurrent impacts of
managerial supports relative to the sum of Upfront and
WithGrace.
- Primary school aged boys’ schooling is negatively affected for
Upfrontfunctional attribute, especially towards the final round.
Consumption and labour incomes
Click here to see the code.
library(ggplot2)
confi <- qread(paste0(pathsaveHere, "EstimatesCI.qs"))
confi2 <- confi[
(grepl("Lab", FileName) |(grepl("OLS", FileName) & num <= 3)) &
#grepl("^Ta?$", regtype) & For Arm, Fun Attribute panels
grepl("^T$", regtype) &
# traditional gross level, nontrad cumulative relative to trad gross
((grepl("Tra", attributes) & grepl("lev.* trad.*d$", ImpactType)) |
(!grepl("Tra", attributes) & grepl("sum", ImpactType))), ]
confi2[grepl("^Large$", attributes), attributes := "Large/Upfront"]
confi2[grepl("Fun", AtType),
AtType := "Functional attributes\n (relative to Upfront, Upfront+WithGrace)"]
confi2 <- confi2[!grepl("^Up", attributes), ]
confi2[, attributes := factor(attributes, levels =
c("Traditional", "Large/Upfront", "LargeGrace", "Cattle",
"WithGrace", "InKind"))]
confi3 <- confi2[!grepl("Tra", attributes), ]
cols <- c("FileName", "regressand", "attributes", "hv", "ImpactType", "AtType")
confi3[, (cols) := droplevels(.SD), .SDcols = cols]
confi3[grepl("lab", regressand), num := num-1]
confi3[, num := factor(num)]
#confi2[grepl("Lab", FileName), estimate := estimate*100]
#confi2[grepl("Lab", FileName), ub := ub*100]
#confi2[grepl("Lab", FileName), lb := lb*100]
p <- ggplot(data = confi3
, aes(x = factor(period), y = estimate,
colour = num, shape = num, group = num)) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .5))
p <- p + facet_grid(regressand ~ attributes, scales = "free_y",
labeller = label_wrap_gen(multi_line = TRUE)) +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 5, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 6),
axis.title = element_text(size = 6),
strip.text.x = element_text(color = "blue", size = 9,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
#panel.spacing.x = unit(c(.1, .1, .3, .1), units = "cm"), For Arm, Fun Attribute panels
panel.spacing.x = unit(c(.1, .1), units = "cm"),
panel.spacing.y = unit(.1, units = "cm"),
legend.position="bottom") +
xlab("periods") +
labs(color = "regression specifications", shape = "regression specifications") +
guides(colour = guide_legend(title = "regression specifications", nrow = 1)) +
geom_hline(aes(yintercept = 0), data = confi3, colour = "lightgreen")
#p <- p + ggh4x::facet_nested(regressand ~ AtType+attributes, scales = "free_y")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/IncomeConsumptionEffects.jpg"),
p,
width = 13*2, height = 8*2, units = "cm",
dpi = 300*4
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/IncomeConsumptionEffects.pdf"),
, width = 13*2/2.54, height = 8*2/2.54)
print(p)
whatever <- dev.off()Consumption and labour income impacts. Large/Upfront ,
LargeGrace, and Cattle give impacts relative
to Traditional arm. Consumption impacts are estimated with
OLS, labour income impacts are estimated with ANCOVA. There are only two
regression specifications for consumption, because we do not expect net
asset at baseline or cattle holding at baseline to affect consumption
changes. Results using these covariates give qualitatively the same
results.
Net assets by experience
Click here to see the code.
library(ggplot2)
confi <- qread(paste0(pathsaveHere, "EstimatesCI.qs"))
cie1 <- confi[
grepl("^NetA.*ts", FileName) & grepl("^non.*-.*\\,", ImpactType) &
grepl("Adi|None|Own", regressand) &
grepl("^T$", regtype), ]
cols <- c("FileName", "regressand", "attributes", "ImpactType")
cie1[, (cols) := droplevels(.SD), .SDcols = cols]
cie1[, SubGroup := factor(gsub(".*ts\\, ", "", regressand))]
cie1[, SubGroup := factor(SubGroup, levels = c("Own", "Adi", "None"))]
cie1[, SubGroup := factor(SubGroup, labels = c("Owner", "Adi", "None"))]
cie1[, num := factor(num-1)]
cie1[, num := gsub("^", "Spec ", num)]
p <- ggplot(data = cie1
, aes(x = factor(period), y = estimate,
colour = SubGroup, shape = SubGroup, group = SubGroup), size = .1) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .5))
p <- p + facet_grid(num ~ attributes) +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 7, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 8),
axis.title = element_text(size = 8),
strip.text.x = element_text(color = "blue", size = 9,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
#panel.spacing.x = unit(c(.1, .1, .3, .1), units = "cm"),
#panel.spacing.y = unit(.1, units = "cm"),
legend.text = element_text(size = 7),
legend.title = element_text(size = 7),
legend.key = element_rect(fill = "white"),
legend.key.size = unit(.25, "cm"),
legend.position="bottom") +
xlab("periods") +
labs(color = "Group by experience", shape = "Group by experience") +
guides(
colour = guide_legend(title = "Group by experience", nrow = 1),
shape = guide_legend(override.aes = list(size = .125))) +
geom_hline(aes(yintercept = 0), data = cie1, colour = "lightgreen")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/NetAssetsByExperienceEffects.jpg")
, p,
width = 12*2, height = 6*2, units = "cm",
dpi = 300*4
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/NetAssetsByExperienceEffects.pdf")
, width = 2*12/2.54, height = 2*6/2.54)
print(p)
whatever <- dev.off()Net assets, experienced vs. inexperienced. Columns of
Large, Large grace, and Cattle
show impacts relative to the Traditional arm.
Cattle holding by experience
Click here to see the code.
library(ggplot2)
confi <- qread(paste0(pathsaveHere, "EstimatesCI.qs"))
confie1 <- confi[
grepl("^Num", FileName) &
!grepl("Exp", FileName) &
grepl("^periN", hv) &
grepl("^T$", regtype) &
!grepl("Trad", attributes), ]
cols <- c("FileName", "regressand", "attributes")
confie1[, (cols) := droplevels(.SD), .SDcols = cols]
confie1[, SubGroup := factor(gsub(".*tle\\, ", "", regressand))]
confie1[, SubGroup := factor(SubGroup, levels = c("cattle", "Own", "Adi", "None"))]
confie1[, SubGroup := factor(SubGroup, labels = c("All members", "Owner", "Adi", "None"))]
addmargins(table(confie1[, .(SubGroup, num)])) num
SubGroup 1 2 3 4 Sum
All members 9 9 9 9 36
Owner 9 9 9 0 27
Adi 9 9 9 0 27
None 9 9 9 0 27
Sum 36 36 36 9 117#### Comparable:
#### NumCows (All) 1 = 1 in all others (not included in confi)
#### NumCows (All) 2 = 2 in Own,
#### NumCows (All) 3 = 3 in Own, 3 in Adi, None (OLS, so not strictly comparable)
#### NumCows (All) 4: does not exist in Own, Adi, None
confie2 <- confie1[grepl("1", num), ]
p <- ggplot(data = confie2
, aes(x = factor(period), y = estimate,
colour = SubGroup, shape = SubGroup, group = SubGroup), size = .1) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .5))
p <- p + facet_grid( ~ attributes) +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 7, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 8),
axis.title = element_text(size = 8),
strip.text.x = element_text(color = "blue", size = 9,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
#panel.spacing.x = unit(c(.1, .1, .3, .1), units = "cm"),
#panel.spacing.y = unit(.1, units = "cm"),
legend.text = element_text(size = 7),
legend.title = element_text(size = 7),
legend.key = element_rect(fill = "white"),
legend.key.size = unit(.25, "cm"),
legend.position="bottom") +
xlab("periods") +
labs(color = "Group by experience", shape = "Group by experience") +
guides(
colour = guide_legend(title = "Group by experience", nrow = 1),
shape = guide_legend(override.aes = list(size = .125))) +
geom_hline(aes(yintercept = 0), data = confie2, colour = "lightgreen")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/NumCowsByExperienceEffects.jpg")
, p,
width = 12*2, height = 4*2, units = "cm",
dpi = 300
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/NumCowsByExperienceEffects.pdf")
, width = 2*12/2.54, height = 2*4/2.54)
print(p)
whatever <- dev.off()Cattle holding, experienced vs. inexperienced. Columns of
Large, Large grace, and Cattle
show impacts relative to the Traditional arm.
Results by poverty class
Click here to see the code.
library(ggplot2)
confi <- qread(paste0(pathsaveHere, "EstimatesCI.qs"))
confi2 <- confi[
(grepl("Lab", FileName) |(grepl("OLS", FileName) & num <= 3)) &
grepl("^TP$", regtype) & grepl("sum.*poor non", ImpactType), ]
confi2[grepl("on", regressand), regressand := "Per capita consumption\n(BDT)"]
confi2[!grepl("on", regressand), regressand := "Labour income\n(BDT)"]
cols <- c("FileName", "regressand", "attributes", "hv", "ImpactType", "AtType")
confi2[, (cols) := droplevels(.SD), .SDcols = cols]
confi2[grepl("lab", regressand), num := num-1]
confi2[, num := factor(num)]
p <- ggplot(data = confi2
, aes(x = factor(period), y = estimate,
colour = num, shape = num, group = num)) +
geom_pointrange(aes(
ymin = lb, ymax = ub),
stat = "identity", fatten = 1.75,
position = position_dodge(width = .5))
p <- p + facet_grid(regressand ~ attributes, scales = "free_y",
labeller = label_wrap_gen(multi_line = TRUE)) +
scale_y_continuous(name = "impacts" #,limits = c(-.35, .15)
) +
scale_x_discrete(name = "periods", breaks = 2:4) +
theme(
axis.text.x = element_text(size = 5, angle = 0, vjust = 1, hjust = 1),
axis.text.y = element_text(size = 6),
axis.title = element_text(size = 6),
strip.text.x = element_text(color = "blue", size = 9,
margin = margin(.1, 1.25, .1, 1.25, "cm")),
strip.text.y = element_text(color = "blue", size = 9,
margin = margin(1.5, .1, 1.5, .1, "cm")),
#panel.spacing.x = unit(c(.1, .1, .3, .1), units = "cm"), For Arm, Fun Attribute panels
panel.spacing.x = unit(c(.1, .1), units = "cm"),
panel.spacing.y = unit(.1, units = "cm"),
legend.position="bottom") +
xlab("periods") +
labs(color = "regression specifications", shape = "regression specifications") +
guides(colour = guide_legend(title = "regression specifications", nrow = 1)) +
geom_hline(aes(yintercept = 0), data = confi2, colour = "lightgreen")
#p <- p + ggh4x::facet_nested(regressand ~ AtType+attributes, scales = "free_y")
ggsave(
paste0(pathprogram,
"figure/EstimationMemo/IncomeConsumptionPovertyEffects.jpg"),
p,
width = 13*2, height = 6*2, units = "cm",
dpi = 300
)
pdf(
paste0(pathprogram,
"figure/EstimationMemo/IncomeConsumptionPovertyEffects.pdf"),
, width = 13*2/2.54, height = 6*2/2.54)
print(p)
whatever <- dev.off()Impacts on consumption and incomes of the ultra poor relative to the
moderately poor. Columns of Large,
Large grace, and Cattle show impacts relative
to the moderately poor of the same arm.
- Consumption of the ultra poor was smaller in
LargeandCattlearms from period 3 onwards.
- This is consistent with the repayment burden to be excessive for the ultra poor, implicating a longer maturity or saving periods.